00100	;Floppy disk file system.
00200	.INSERT ASMBL.FAI[CMS,LCS]
00300	   ZERO ← 0
00400	   LOC ZERO ;Fail offset
00500	
00600	CBLK:	0	;Ram command block.
00700	CCNT:	0	;C parameter count.
00800	CLEN:	0	;C # of sectors.
00900	CSEC:	0	;C sector
01000	CTRK:	0	;C track
01100		0
01200	FOTRK:	0	;Format track number.
01300		0
01400	FCMD:	0	;Disk command pointer.
01500	FCMDH:	0
01600	CMDJMP:	0	;Indirect command jump.
01700	CJMPH:	0	;Msbyte.
01800	ERFLG:	0	;Error flag/code.
01900	SVERR:	0	;Saved error.
02000	CEFLG:	0	;Communication error flag.
02100	RFOPEN:	0	;Read file open flag.
02200	WFOPEN:	0	;Write file open flag
02300	DIRC:	0	;Data direction
02400	FLEN:	0	;File length. In sectors.
02500	FITRK:	0	;Compress file track.
02600	FISEC:	0	;Compress file sector.
02700	SREM:	0	;Sectors remaining.
02800	NTRYS:	0	;Number of retrys before error.
02900	BUSY:	0	;Busy flag
03000	MO:	0	;Motor on flag. MFLG = TL or TH?
03100	TL:	0	;Motor time out low.
03200	TH:	0	;Time out high.
03300	DIRCNT:	0	;Directory sector count
03400	HLEN:	0	;Hole sector count.
03500	HTRK:	0	;Hole track number
03600	HSEC:	0	;Hole sector number
03700	SVHY:	0	;Hole directory index.
03800	SVHSEC:	0	;Hole directory sector.
03900	NXHSEC:	0	;Next hole sector.
04000	SVSEC:	0	;Other directory sector.
04100	SVOSEC:	0	;Old directory sector.
04200	
04300	FBLK:	0	;File block
04400	FNAME:	BLOCK 11	;9 Chr file name.
04500	NSEC:	0	;Number of sectors in file.
04600	FTRK:	0	;Disk track number
04700	FSEC:	0	;Disk sector number
04800		BLOCK 3
04900	DBLK:	0	;Directory block
05000	DSEC:	0	;Number of sectors in directory.
05100	FFDIR:	0	;First free directory block
05200	FFTRK:	0	;First free data track
05300	FFSEC:	0	;First free data sector
05400	FBLKS:	0	;Number of free sectors. In sectors.
05500	FBH:	0	;Msbyte
05600		0
05700	CKSUM:	0	;Check sum.
05800	SPOINT:	0	;SI/O pointer.
05900	SPOH:	0	;Msbyte
06000	DPOINT:	0	;Disk buffer bointer.
06100	DPOH:	0	;Msbyte
     

00100	OCTL:	0	;Lsbyte of octal to decimal.
00200	OCTH:	0	;Msbyte.
00300	DIGIT:	0	;Tens or hundreds.
00400	
00500	   LOC ZERO+1000
00600	FBUF:	0	;Disk data buffer.
00700	   LOC FBUF+400
00800	FBUF1:	0	;Other buffer.
00900	
01000	;PROM Start address.
01100	   LOC ZERO+174000
01200	FCTBL:
01300	   DINIT ← 0
01400		65	;Specify
01500		4	;Parameter count.
01600		252	;H unload I cnt./ H load time.
01700		=25	;Head settling time in ms*2.
01800		=20	;Step rate in ms*2.
01900		15	;Init
02000	   SBT ← 6
02100		65	;Specify
02200		4
02300		0	;Current track.
02400		377
02500		377	;No bad tracks.
02600		20	;Surface zero bad tracks command.
02700	   DMA ← 14
02800		172	;Write special register.
02900		2
03000		0	;DMA and double actuator.
03100		27	;Mode register.
03200	   RESTOR ← 20
03300		151	;Seek track zero command.
03400		1	;With head load.
03500		0	;Track zero
03600	   MON ← 23
03700		172	;Write special register.
03800		2	;Clear out pins.
03850		40	;Motor on bit.
03900		43	;Drive control output register.
03920	   MOFF ← 27
03940		172	;Write special register.
03960		2
03980		0	;Motor off.
03990		43	;Drive control output register.
04000	   RDSTAT ← 33
04100		154	;Read drive status command.
04200		0
04600	RH0:	123	;Read two sectors command.
04700		3
04800		2	;# of sectors.
04900		1	;Header sector number
05000		0	;Header track number
05100	WH0:	113	;Write two sectors command.
05200		3
05300		2	;# of sectors.
05400		1	;Header sector number.
05500		0	;Header track number.
     

00100	ID0:	113	;Write two sectors.
00200		3
00300		=16	;# of sectors.
00400		1	;First sector.
00500		0	;Track zero.
00600	FORMT:	143	;Format track command.
00700		5
00800		=16	;Gap 1 -6.
00900		0	;Gap 5. No index mark.
01000		=16	;Sectors per track.
01100		=27	;Gap 3 -6.
01200		0	;Format track number.
01300	
01400	   RETRY ← =10	;Number of retrys until error.
01500	   DMARK ← 74	;Directory mark
01600	   FMARK ← 72	;File mark
01700	   HMARK ← 67	;Hole mark.
     

00100	;Flush NXHSEC?
00200	;Add restore to retry?
00300	;Add write protect and not ready error codes.
00400	
00500	;Power on reset.
00600	RST:	LDXI	377	;Setup stack.
00700		TXS
00800		CLD	;Clear decimal mode.
00900	
01000	;Reset I/O
01100	   SIOC  ← 20000	;SI/O command register.
01200	   SIOD  ← 20001	;SI/O data register.
01300	   FDSKC ← 10000	;Disk command/status register
01400	   FDSKP ← 10001	;Disk parameter/result register
01500	   FDSKR ← 10002	;Disk reset register.
01600	   FDRQ  ← 14000	;Disk DMA data request
01700	
01800	;Init floppy disk controller.
01900		LDAI	1	;Reset disk again.
02000		STA	FDSKR
02100		NOP
02200		NOP
02300		NOP
02400		LSRA	;Clear A
02500		STA	FDSKR
02600	
02700		LDAI	DINIT	;Disk initialization command.
02800		JSR	PCMD	;Prom command.
02900		LDAI	DMA	;Setup DMA mode.
03000		JSR	PCMD
03100	
03200		LDXI	0
03300		STXZ	TL
03400		LDAI	10	;10 = 1.3s.
03500		STAZ	TH
03600	RLOOP:	DEX	;Power on delay.
03700		BNE	RLOOP
03800		DECZ	TL
03900		BNE	RLOOP
04000		DECZ	TH
04100		BNE	RLOOP
04200	
04300		LDAI	RESTOR	;Restore track zero.
04400		JSR	PCMD
04500		LDAI	SBT	;Setup bad tracks
04600		JSR	PCMD
04700	;Reset SI/O
04800		LDAI	3	;Reset bits
04900		STA	SIOC
05000		LDAI	25	;ACIA control word.
05100		STA	SIOC
05200	
05300	;Init RAM
05400		LDAZ	DSEC
05500		STAZ	DIRCNT	;Point to end of directory.
05600		LDAI	0
05700		STAZ	MO	;Init motor flag.
     

00100	IDLSET:	LDAI	0
00200		STAZ	RFOPEN	;Reset read file open flag.
00300		STAZ	WFOPEN	;Clear write file open flag.
00400	
00500		STAZ	CEFLG	;Clear comm. error flag.
00600		STAZ	ERFLG	;Clear error flag.
00700		STAZ	SVERR	;Clear other error flag.
00800	
00900		STAZ	DIRC	;Set disk to read.
01000		STAZ	BUSY	;Set to not busy.
01100		TAX	;Start lsbyte of motor time out.
01200		CLI	;Enable interrupts.
01300	
01400	   TWOS ← 3	;3 = 1.77s, 4 = 2.3s.
01500	IDLE:	BITZ	MO	;Check if motor on.
01600		BPL	GSOH
01700		LDA	SIOC	;Read SI/O status.
01800		LSRA	;Get rcvr. full bit.
01900		BCS	GSOH
02000	
02100		DEX	;Time out countdown.
02200		BNE	IDLE
02300		DECZ	TL
02400		BNE	IDLE
02500		DECZ	TH
02600		BNE	IDLE
02700	
02800		INX
02900		INCZ	TL
03000		INCZ	TH
03100		BITZ	BUSY	;Check if disk is busy.
03200		BMI	IDLE
03300		JSR	MOTOFF	;Turn off motor.
03400	
03500	GSOH:	JSR	GCHR	;Wait for SOH.
03600		CMPI	1	;<SOH>.
03700		BNE	ILLCMD	;Error.
03800		JSR	GCHR	;Wait for command.
     

00100	DCODE:	LDXI	NCMDS	;# of commands.
00200	DL:	CMPX	CMDTBL	;Check if valid command.
00300		BEQ	JCMD
00400		DEX
00500		BPL	DL
00600	;Illegal command.
00700	ILLCMD:	LDXI	4	;Command error code.
00800	OCLR:	JSR	OCHR	;Output status.
00900		JMP	IDLSET	;Reset flags.
01000	
01100	JCMD:	LDAX	JLTBL	;Get lsbyte of jump address.
01200		STAZ	CMDJMP
01300		LDAX	JHTBL	;Get msbyte.
01400		STAZ	CJMPH
01500	
01600		JMPIN	CMDJMP	;Excute command.
01700	
01800	   NCMDS ← =9	;# of commands -1.
01900	CMDTBL:	"P"	;Perform special function.
02000		"K"	;Delete file.
02100		"B"	;Free blocks
02200		"N"	;Next directory block.
02300		"D"	;Open directory.
02400		"C"	;Close write file.
02500		"E"	;Enter write file.
02600		"O"	;Open read file.
02700		"W"	;Write data
02800		"R"	;Read data
02900	
03000	JLTBL:	PSF∧377	;Lsbyte of command address.
03100		KIL∧377
03200		BLKS∧377
03300		NXTDIR∧377
03400		DIR∧377
03500		CLOZE∧377
03600		ENTR∧377
03700		OPIN∧377
03800		WRITE∧377
03900		READ∧377
04000	
04100	JHTBL:	PSF⊗-10	;Msbyte of command address.
04200		KIL⊗-10
04300		BLKS⊗-10
04400		NXTDIR⊗-10
04500		DIR⊗-10
04600		CLOZE⊗-10
04700		ENTR⊗-10
04800		OPIN⊗-10
04900		WRITE⊗-10
05000		READ⊗-10
     

00100	;Write command to FDSKC. No wait or * NTRYS.
00200	PCMD:	STAZ	FCMD	;Prom command with no retrys.
00300		LDAI	370	;Msbyte of command table addr.
00400		STAZ	FCMDH
00500		LDAI	0
00600		STAZ	NTRYS
00700		BEQ	SETPO	;Jump.
00800	
00900	RCMD:	LDAI	0	;Ram command with no retrys.
01000		STAZ	NTRYS
01100	TRY:	LDAI	0
01200		STAZ	FCMD
01300		STAZ	FCMDH
01400	
01500		LDAI	377	;Set busy.
01600		STAZ	BUSY
01700		LDAI	0
01800	SETPO:	STAZ	DPOINT	;Reset disk DMA pointer.
01900	
02000	BSYW:	LDA	FDSKC	;Wait until not busy.
02100		BMI	BSYW
02200	
02300		LDYI	0
02400		LDAIY	FCMD	;Get command code.
02500		STA	FDSKC	;Write in disk control reg.
02600	
02700		INCZ	FCMD	;Point to parameter count.
02800		LDAIY	FCMD	;Get count.
02900		BEQ	NOPAR	;If no parameters
03000		TAY
03100	
03200	PARW:	LDA	FDSKC	;Read status
03300		ANDI	40	;P reg full bit.
03400		BNE	PARW	;Wait if still full.
03500	
03600		LDAIY	FCMD	;Parameter
03700		STA	FDSKP
03800		DEY
03900		BNE	PARW	;More left?
04000	
04100	NOPAR:	RTS
04200	
04300	WBUFR:	LDAI	113	;Write two sectors command.
04400		STAZ	CBLK
04500	WUF:	LDAI	377
04600		STAZ	DIRC	;Set to write.
04700	
04800	;Disk command with retrys on read error.
04900	RCMDR:	LDAI	RETRY	;RAM disk command.
05000		STAZ	NTRYS
05100		BNE	TRY
05200	
05300	RCMDW:	JSR	RCMDR	;Read command wait.
05400	BW:	BITZ	BUSY
05500		BMI	BW	;Wait until done
05600		LDAZ	ERFLG	;Get error bits.
05700		RTS	;Return with error bits.
     

00100	;IRQ maskable interrupt routine.
00200	IRQV:	PHA	;Save Registers.
00300		TYA
00400		PHA
00500	   ;Wait for result bit?
00600		LDA	FDSKP	;Read disk result register.
00700		ANDI	36	;Flush ddbit
00800		STAZ	ERFLG
00900	
00950		LDYI	200
01000	CKIRQ:	INY	;IRQ reset delay.
01050		BNE	CKIRQ
01500	
01600		LDAZ	ERFLG	;Get error bits.
01700		BNE	DSKERR	;Disk error.
01800		LDAZ	CBLK	;Get last disk command.
01900		CMPI	113	;Check if write command.
02000		BNE	NOTBSY
02100	
02200		LDAI	137	;Disk verify command.
02300		STAZ	CBLK
02400		JSR	TRY	;Verify write.
02500		JMP	RTRN	;Wait until done.
02600	
02700	DSKERR:	ANDI	20	;Bad bit
02800		BEQ	CKTRY
02900	;Dsk error: RDY,WRT fault, etc.
03000	;Fix for WPRT etc.
03100		STAZ	SVERR	;Save bad error.
03200	;Read drive status if not ready for clear.
03300	   ;Check if not ready?
03400		LDAI	RDSTAT	;Read drive status.
03500		JSR	PCMD	;No interrupt.
03600		JSR	GRSLT	;Wait for result.
03700	;20 Not ready.
03800	;21 Write protect.
03900	;22 Restore error.
04000	;23 File not found.
04100	;30 Sector not found.
04200		JMP	NOTBSY
04300	
04400	CKTRY:	LDAZ	NTRYS
04500		BEQ	SETERR
04600		
04700		DECZ	NTRYS
04800		JSR	TRY	;Retry command.
04900		JMP	RTRN	;Wait until done.
05000	
05100	SETERR:	LDAI	377	;Retry error.
05200		STAZ	SVERR
05300	
05400	NOTBSY:	LDAI	0
05500		STAZ	BUSY	;Set done
05600		STAZ	DIRC	;Reset to read.
05700	
05800	RTRN:	PLA	;Restore Registers.
05900		TAY
06000		PLA
06100		RTI	;Return
     

00100	;Directory look up.
00200	;Returns with file found, fnf, or read error.(0,200,XX)
00300	LOKUP:	LDXI	0
00400	GNAME:	JSR	GCHR	;Get name.
00500		CMPI	4	;<EOT>.
00600		BEQ	CKNAME
00700		STAZX	FNAME
00800		INX
00900		CPXI	=10	;9 Chr file name + EOT.
01000		BCC	GNAME
01100	
01200	ILCJMP:	PLA	;One level pop to ILLCMD.
01300		PLA
01400		JMP	ILLCMD
01500	
01600	CKNAME:	TXA	;Test X.
01700		BEQ	ILCJMP	;No file name.
01800		LDAI	" "	;<Space>.
01900	PAD:	STAZX	FNAME	;Pad file name with spaces.
02000		INX
02100		CPXI	=9
02200		BCC	PAD
02300	
02400		JSR	RHDR	;Read directory header sector.
02500		BNE	LUERR
02600		LDAI	FMARK
02700		STAZ	FBLK
02800	
02900	GETS:	JSR	RNDS	;Read next 2 directory sectors.
03000		BNE	LUERR
03100		LDYI	0
03200	CKDIR:	LDXI	0
03300	CKNAM:	LDAY	FBUF
03400		CMPZX	FBLK	;Look for file name.
03500		BNE	NXTF	;No match
03600		INY
03700		INX
03800		CPXI	=11	;9 chrs. + fmark + 1.
03900		BCC	CKNAM
04000	;Names match
04100	FMOV:	LDAY	FBUF	;Save file record.
04200		STAZX	FBLK
04300		INY
04400		INX
04500		CPXI	20
04600		BCC	FMOV
04700	
04800		LDAI	0	;Return with file found.
04900	LUERR:	RTS	;Return with error bits.
05000	
05100	NXTF:	TYA	;Point to next file record.
05200		ORAI	17
05300		TAY
05400		INY
05500		BNE	CKDIR
05600	
05700		DECZ	SREM	;Check if more sectors.
05800		DECZ	SREM
05900		BNE	GETS
06000		LDAI	200	;Return file not found code.
06100		RTS
     

00100	;Read 1st sec of a directory. Returns with 0 or Ebits.
00200	RHDR:	JSR	MOTON	;Turn on motor and delay.
00300		LDXI	4
00400	CSET:	LDAX	RH0	;Setup command list.
00500		STAZX	CBLK
00600		DEX
00700		BPL	CSET
00800	
00900		JSR	SETDPO	;Point disk to FBUF.
01000		JSR	RSEC	;Read it * 16.
01100		BNE	HERR
01200		LDA	FBUF
01300		CMPI	DMARK	;Check for directory.
01400		BNE	HERR
01500	
01600		LDXI	7
01700	GHL:	LDAX	FBUF
01800		STAZX	DBLK
01900		DEX
02000		BPL	GHL
02100		LDAZ	DSEC
02200		STAZ	SREM	;Number of sectors in dir.
02300		STAZ	DIRCNT	;Reset directory count.
02400		LDAI	0	;No error return
02500	HERR:	RTS	;Return with error bits.
02600	
02700	;Read a block routine.
02800	REED:	LDAI	123	;Read two sectors command.
02900		STAZ	CBLK
03000		BNE	RSEC
03100	;Read next dir. sector. Returns with error bits.
03200	RNDS:	INCZ	CSEC	;Read next dir sec.
03300		INCZ	CSEC
03400	RSEC:	LDAI	0	;Reset file open flags.
03500		STAZ	RFOPEN
03600		STAZ	WFOPEN
03700	
03800		JSR	RCMDW	;Disk command wait * RETRYS
03900		BEQ	GOTIT	;Good read
04000		LDAI	1	;Directory 1.
04100		STAZ	CTRK
04200		JSR	RCMDW
04300		LDAI	0	;Fix CTRK for next read.
04400		STAZ	CTRK
04500		LDAZ	ERFLG	;Get error bits.
04600	GOTIT:	RTS	;Return with error bits.
04700	
04800	SETDPO:	LDAI	FBUF⊗-10	;Point disk to FBUF.
04900		STAZ	DPOH
05000		LDAI	0
05100		STAZ	DPOINT
05200		RTS
05300	
05400	INCSEC:	INX	;Increment sector and track address.
05500		INX
05600		CPXI	=16
05700		BCC	NXTBLK
05800		ADCI	0	;TRK ← TRK + 1.
05900		LDXI	1	;First sector.
06000	NXTBLK:	RTS
     

00100	;Open read file.
00200	OPIN:	BITZ	WFOPEN	;Check if write file open.
00300		BPL	LOOK
00400		JMP	FAO	;File already open error.
00500	
00600	LOOK:	JSR	LOKUP	;Lookup file FNAM
00700		BEQ	SETOPN
00800		CMPI	200	;File not found code.
00900		BEQ	NACKIT
01000		JMP	DIRERR	;Directory read error
01100	NACKIT:	JMP	FNF	;File not found.
01200	
01300	SETOPN:	LDAZ	FTRK	;Get track and sector
01400		STAZ	CTRK
01500		LDAZ	FSEC
01600		STAZ	CSEC
01700		LDAZ	NSEC	;Get file length.
01800		STAZ	SREM
01900	;Fill FBUF
02000		JSR	RCMDR	;* NTRYS and no wait.
02100	
02200		JSR	SETSPO	;Point SPOINT to FBUF.
02300		LDAI	377
02400		STAZ	RFOPEN
02500	
02600	ACK:	LDXI	20	;<ack>
02700	OACK:	JSR	OCHR	;Output byte.
02800		JMP	IDLE	;No flag clear.
02900	
03000	SETSPO:	LDAI	FBUF⊗-10	;Reset SI/O pointer.
03100		STAZ	SPOH
03200		LDAI	0
03300		STAZ	SPOINT
03400		RTS
03500	
03600	;Non-maskable DRQ interrupt.
03700	NMIV:	PHA	;Save registers
03800		TYA
03900		PHA
04000		LDYI	0	;No index.
04100	
04200		BITZ	DIRC	;Get direction.
04300		BMI	WDRQ	;Disk write.
04400	
04500		LDA	FDRQ	;Read byte from disk.
04600		STAIY	DPOINT	;Save it in FBUF
04700	
04800	INCPO:	INCZ	DPOINT
04900	
05000		PLA	;Restore registers.
05100		TAY
05200		PLA
05300		RTI	;Return
05400	
05500	WDRQ:	LDAIY	DPOINT	;Get byte from FBUF.
05600		STA	FDRQ	;Write into disk data register.
05700		JMP	INCPO
     

00100	;Read a block of the file.
00200	READ:	JSR	GEOT	;Wait for EOT.
00300		BITZ	RFOPEN	;Check if file open.
00400		BMI	CKS
00500		JMP	FNF	;File not found
00600	CKS:	LDAZ	SREM	;Check for end of file.
00700		BNE	READO	;For FLEN = 0.
00800	EOF:	LDXI	6	;End of file error code.
00900		JMP	OCLR	;Output X and clear flags.
01000	
01100	READO:	LDAI	0	;Init check sum.
01200		STAZ	CKSUM
01300		JSR	BW	;Wait until not busy.
01400		BEQ	NXTBUF
01500	DRERR:	LDXI	14	;Disk read error.
01600		JMP	OCLR	;Clear all flags.
01700	
01800	NXTBUF:	DECZ	SREM	;Check if end of file.
01900		DECZ	SREM
02000		BEQ	ACKIT
02100	   ;Start read of next buffer.
02200		LDXZ	CSEC
02300		LDAZ	CTRK
02400		JSR	INCSEC	;Get next sector.
02500		STXZ	CSEC
02600		STAZ	CTRK
02700	
02800	RNS:	JSR	SWDBUF	;Swap disk buffers.
02900		JSR	MOTON	;Turn on motor.
03000		JSR	RCMDR	;No wait. Set CBLK?
03100	ACKIT:	JSR	PACK	;Output <ack>.
03200		JSR	PSTX	;Output <stx>.
03300	
03400		LDYI	0
03500	RDIT:	LDAIY	SPOINT	;Output a buffer full.
03600		TAX
03700		JSR	OCHR
03800		TXA
03900		CLC
04000		ADCZ	CKSUM
04100		STAZ	CKSUM
04200		INY
04300		BNE	RDIT
04400	
04500		JSR	SWSBUF	;Swap SI/O buffers.
04600		LDAZ	CKSUM	;Output check sum.
04700		EORI	377
04800		TAX
04900		INX
05000		JMP	OACK	;Output it and no flag clear.
05100	
05200	SWSBUF:	LDAZ	SPOH
05300		EORI	1	;Swap SI/O buffers.
05400		STAZ	SPOH
05500		RTS
     

00100	;Create file routine
00200	ENTR:	BITZ	WFOPEN	;Check if file already open
00300		BPL	LOKIT
00400	FAO:	LDXI	10	;File already open error.
00500		JMP	OACK	;Output it. No flag clear.
00600	LOKIT:	JSR	LOKUP	;Check if file already exists.
00700		BEQ	FEXIST	;Check if file exists
00800		CMPI	200	;Not in dir. code
00900		BEQ	FULCK
01000	DIRERR:	LDXI	13	;Directory read error code.
01100	CLRJMP:	JMP	OCLR	;Clear flags.
01200	
01300	FEXIST:	LDXI	2	;File exists error code.
01400		BNE	CLRJMP	;Clear flags.
01500	
01600	DSKFUL:	LDAI	=35	;Disk full.
01700		STAZ	FFTRK	;Set full flag.
01800	DFUL:	LDXI	5	;Disk full code.
01900		JMP	OACK	;No flag clear?
02000	
02100	FULCK:	LDAZ	FFTRK	;Get first free track.
02200		CMPI	=35	;Check if disk full.
02300		BCS	DFUL
02400	
02500		STAZ	CTRK	;Point to new file.
02600		STAZ	FTRK	;Setup file block.
02700		STAZ	CLEN	;Track number for seek.
02800		LDAI	151	;Seek track command.
02900		STAZ	CBLK
03000		LDAI	1
03100		STAZ	CCNT
03200	
03300		JSR	RCMD	;Seek track.
03400	
03500		LDXI	3	;Setup command parameter count.
03600		STXZ	CCNT
03700		STXZ	DPOH	;Point disk to other buffer.
03800		DEX	;Setup number of sectors.
03900		STXZ	CLEN
04000		LDXZ	FFSEC
04100		STXZ	FSEC	;Setup file block.
04200		DEX	;-2 For inc. before write.
04300		DEX
04400		STXZ	CSEC
04500	
04600		JSR	SETSPO	;Point SI/O to FBUF.
04700		LDXI	0
04800		STXZ	FLEN	;Reset file length.
04900	
05000		DEX	;Set write file open flag.
05100		STXZ	WFOPEN
05200		JMP	ACK	;Return with no errors
     

00100	;Write file.
00200	WRITE:	JSR	GEOT	;Wait for EOT.
00300		BITZ	WFOPEN	;Check if file open.
00400		BMI	WIT
00500		JMP	FNF	;File not found
00600	WIT:	LDAZ	FFTRK
00700		CMPI	=35	;Check if disk is full.
00800		BCS	DSKFUL
00900	
01000		LDAI	0
01100		STAZ	CKSUM	;Init check sum.
01200	
01300		JSR	PACK	;Output <ACK>.
01400		JSR	GCHR	;Wait for STX.
01500		CMPI	2	;<STX>.
01600		BNE	COMERR	;No STX.
01700	
01800		LDYI	0
01900	WLOOP:	JSR	GCHR	;Fill FBUF.
02000		STAIY	SPOINT
02100		CLC
02200		ADCZ	CKSUM	;Update check sum.
02300		STAZ	CKSUM
02400		INY
02500		BNE	WLOOP
02600	
02700		JSR	GCHR	;Get check sum.
02800		CLC
02900		ADCZ	CKSUM	;Check for check sum error.
03000		BNE	COMERR
03100		LDAZ	CEFLG	;Check for communication error.
03200		BEQ	WBUF
03300	COMERR:	LDXI	11	;Communication error.
03400		JMP	OCLR	;Reset flags.
03500	
03600	WBUF:	BITZ	BUSY	;Wait until last buffer done.
03700		BMI	WBUF
03800		LDAZ	ERFLG	;Check for errors.
03900		BEQ	NFBLK
04000		JMP	DRERR	;Write error. Verify error?
04100	NFBLK:	LDXZ	CSEC	;Fix sector number.
04200		LDAZ	CTRK
04300		JSR	INCSEC
04400		STXZ	CSEC
04500		STAZ	CTRK
04600		CMPI	=35	;Check if disk is full.
04700		BCC	SWBUF
04800		JMP	DSKFUL
     

00100	SWBUF:	JSR	SWDBUF	;Swap disk buffers.
00200		JSR	MOTON	;Turn on motor.
00300		JSR	WBUFR	;Write buffer.
00400		
00500		JSR	SWSBUF	;Swap SI/O buffers.
00600		INCZ	FLEN	;Update file length.
00700		INCZ	FLEN
00800		JMP	ACK	;No error return.
00900	
01000	WBUFW:	JSR	WBUFR	;Write it.
01100		JMP	BW	;Return with E bits when done.
01200	
01300	SWDBUF:	LDAZ	DPOH
01400		EORI	1	;Swap disk buffers.
01500		STAZ	DPOH
01600		RTS
     

00100	CLOZE:	JSR	GEOT	;Wait for EOT.
00200		BITZ	WFOPEN	;Check if file open
00300		BMI	UPDIR
00400		JMP	FNF	;File not found.
00500	
00600	;Update directory
00700	UPDIR:	BITZ	BUSY	;Wait until not busy.
00800		BMI	UPDIR	;Done with last write.
00900		LDAZ	ERFLG	;Check for error.
01000		BEQ	BUMP
01100		JMP	DRERR	;Last buffer write error?
01200	
01300	BUMP:	LDAZ	FLEN	;Save file length.
01400		STAZ	NSEC
01500		LDAZ	CTRK	;Save new FFTRK.
01600		LDXZ	CSEC	;Point to next free data block.
01700		JSR	INCSEC
01800		STAZ	HTRK
01900		STXZ	HSEC	;Save new FFSEC.
02000	
02100	;Read last directory sector.
02200		JSR	MOTON	;Turn on motor.
02300		LDAI	0	;Track zero.
02400		STAZ	CTRK
02500	
02600		LDXZ	DSEC	;Last directory sector -1.
02700		INX	;Bump.
02800		STXZ	CSEC
02900		STXZ	SVOSEC	;Save last dir. sec. number.
03000		JSR	SETDPO	;Point to FBUF.
03100		JSR	REED	;Read next dir. sec.
03200		BEQ	CLOZIT
03300		JMP	DIRERR	;Directory read error.
03400	
03500	CLOZIT:	LDYZ	FFDIR
03600	
03700		LDXI	0	;BLT FBLK into directory
03800	NAMEIT:	LDAZX	FBLK
03900		STAY	FBUF
04000		INY
04100		INX
04200		CPXI	20	;FBLK Length
04300		BCC	NAMEIT
     

00100	;Update directory header.
00200	WRTH0:	TYA	;Get next free directory block.
00300		STAZ	FFDIR
00400		BNE	UPFF
00500		INCZ	DSEC	;Next sector
00600		INCZ	DSEC
00700		LDAZ	DSEC	;Check if directory full.
00800		CMPI	=15
00900		BCC	UPFF
01000		LDAI	=14	;Last directory sector.
01100		STAZ	DSEC
01200		LDAI	=35	;Set disk full.
01300		STAZ	HTRK
01400	UPFF:	LDAZ	HSEC	;Point to next free block.
01500		STAZ	FFSEC
01600		LDAZ	HTRK
01700		STAZ	FFTRK
01800		SEC
01900		LDAZ	FBLKS
02000		SBCZ	FLEN	;Update free blocks.
02100		STAZ	FBLKS
02200		BCS	WDIR
02300		DECZ	FBH
02400	WDIR:	LDXI	7	;Header length.
02500	HLOOP:	LDAZX	DBLK	;BLT Header into directory.
02600		STAX	FBUF1	;Other buffer.
02700		DEX
02800		BPL	HLOOP
02900	
03000		LDAI	1	;First sector.
03100		STAZ	SVSEC
03200		JSR	WBUFS	;Write 4 bufs on 2 tracks.
03300		BNE	CLZERR	;Check for close error.
03400		STAZ	WFOPEN	;Close write open flag.
03500	ACKCLR:	LDXI	20	;<Ack>.
03600		JMP	OCLR	;Output <Ack> and clear flags.
03700	
03800	CLZERR:	JMP	DIRERR	;?
03900	
04000	   ;Add error checks after WBUFWs?
04100	WBUFS:	JSR	WBUFW	;Write dir. 0.
04200	
04300		LDAZ	SVSEC	;First sector.
04400		STAZ	CSEC
04500		JSR	SWDBUF	;Swap disk buffers.
04600	
04700		JSR	WBUFW	;Write dir. header 0.
04800		LDAI	1	;Directory 1.
04900		STAZ	CTRK
05000		JSR	WBUFW	;Write dir. header 1.
05100	   ;Write last track directory.
05200		LDAZ	SVOSEC	;Get last dir.sec. number.
05300		STAZ	CSEC
05400		JSR	SWDBUF	;Swap buffers.
05500		JSR	WBUFW
05600	
05700		LDAZ	SVERR	;?
05800		RTS	;Return with error bits.
     

00100	PSF:	JSR	GEOT
00200		JSR	PACK	;<Ack>
00300		JSR	GCHR	;Wait for SOH.
00400		CMPI	1	;SOH
00500		BNE	PSFERR
00600		JSR	GCHR	;Wait for special function cmd.
00700		CMPI	"Q"	;Compress holes.
00800		BNE	CKF
00900		JSR	GEOT	;Wait for EOT.
01000		JMP	CMPRES
01100	
01200	CKF:	CMPI	"F"	;Format disk.
01300		BNE	CKI
01400		JMP	FORM
01500	CKI:	CMPI	"I"	;Initialize directory.
01600		BEQ	IDIR
01700	PSFERR:	JMP	ILLCMD	;Command error.
01800	;Initialize directory.
01900	IDIR:	JSR	GEOT	;Wait for EOT.
02000		JSR	MOTON	;Turn on motor.
02100		LDXI	10
02200		LDAI	0
02300	ZE:	STAX	FBUF	;Zero directory
02400		INX
02500		BNE	ZE
02600		LDXI	7
02700	DIIL:	LDAX	DIT	;Init dir.
02800		STAX	FBUF
02900		DEX
03000		BPL	DIIL
03100	
03200		LDXI	4
03300	SETC:	LDAX	ID0	;Setup CBLK.
03400		STAZX	CBLK
03500		DEX
03600		BPL	SETC
03700	
03800		JSR	SETDPO	;Point disk to FBUF.
03900		JSR	WBUFW	;Write first header and dir.
04000		LDAI	1	;Directory 1.
04100		STAZ	CTRK
04200		JSR	WBUFW	;Init last directory.
04300	
04400		LDAZ	SVERR
04500		BNE	IDERR
04600		JMP	ACKCLR	;<Ack> and clear flags.
04700	IDERR:	LDXI	7	;Init dir. error.
04800		JMP	OCLR	;Reset flags.
04900	
05000	DIT:	DMARK
05100		2	;# of sectors
05200		0	;FFDB
05300		2	;FFT
05400		1	;FFS
05500		=528∧377	;FBL
05600		=528⊗-10	;FBH
05700		0
     

00100	;Delete file.
00200	KIL:	JSR	LOKUP
00300		BEQ	KILIT
00400	   ;Check for directory read error?
00500	FNF:	LDXI	3	;File not found.
00600		JMP	OCLR
00700	KILIT:	DEY	;Fix directory pointer.
00800		LDAI	HMARK
00900		STAY	761	;FBUF - 17
01000		LDXZ	CSEC
01100		STXZ	SVOSEC	;Save directory sector #.
01200		INY	;Next directory block.
01300		CPYZ	FFDIR	;Check if last dir. block.
01400		BNE	DEL
01500		DEX
01600		TYA	;A ← Old FFDIR.
01700		BNE	CKSEC
01800		INX
01900		INX
02000	CKSEC:	CPXZ	DSEC	;Check if last block in dir.
02100		BNE	DEL
02200		SEC
02300		SBCI	20	;Point to FFDIR -1 block.
02400		STAZ	FFDIR
02500		TYA	;Test Y.
02600		BNE	DEL
02700		DECZ	DSEC	;Directory sector -2.
02800		DECZ	DSEC
02900	
03000	DEL:	JMP	WDIR	;Write header and directory.
03100	
03200	;Output free blocks.
03300	BLKS:	JSR	GEOT	;Wait for EOT.
03400		JSR	RHDR	;Read directory header.
03500		BNE	JDER	;Directory read error.
03600		JSR	PACK	;<ack>
03700		JSR	PSTX	;Output STX.
03800		LDAZ	FBH	;Get msbyte of free blocks.
03900		LDXZ	FBLKS	;Get lsbyte.
04000		JSR	ODEC	;Output 3 decimal digits.
04100	OEOT:	LDXI	4	;<EOT>.
04200		JMP	OCLR	;Clear flags.
04300	
04400	GRSLT:	LDA	FDSKC	;Read disk status.
04500		BMI	GRSLT	;Wait until not busy.
04600		LDA	FDSKP	;Get result.
04700		RTS
     

00100	DIR:	JSR	GEOT	;Wait for EOT.
00200		JSR	RHDR	;Read header.
00300		BEQ	RQDIR
00400	JDER:	JMP	DIRERR	;Error.
00500	RQDIR:	LDAI	0	;Point to start
00600		STAZ	DIRCNT
00700	JACK:	JMP	ACKCLR	;<Ack> and clear flags.
00800	
00900	NXTDIR:	JSR	GEOT	;Wait for EOT.
01000		LDXZ	DIRCNT	;Check if at end.
01100		CPXZ	DSEC	;Check if done.
01200		BCC	NXD
01300		JMP	EOF
01400	NXD:	INX
01500		INX
01600		STXZ	DIRCNT	;Update directory count.
01700		INX	;Bump past dir. header.
01800		STXZ	CSEC
01900		JSR	MOTON	;Turn on motor.
02000		JSR	RSEC	;Read next directory sector.
02100		BNE	JDER
02200	
02300		JSR	PACK	;Output <ACK>.
02400		JSR	PSTX	;Output <STX>.
02500		LDYI	0
02600	DOL:	LDAY	FBUF	;Find file in FBUF.
02700		LDXI	11	;9 Chr file name.
02800		STXZ	HSEC
02900	
03000	OUTDIR:	CMPI	FMARK
03100		BNE	OUTZ
03200	
03300		LDXY	1001	;FBUF + 1.
03400	FBOUT:	PHA
03500	        JSR	OCHR	;Output it.
03600	        PLA
03700		INY
03800		DECZ	HSEC
03900		BNE	OUTDIR
04000	
04100		LDXI	" "	;<Space>.
04200		JSR	OCHR
04300	
04400		LDAI	0	;Msbyte of file length.
04500		LDXY	1001	;Get lsbyte from FBUF.
04600		JSR	ODEC	;Output 3 ascii decimal digits.
04700	
04800		TYA
04900		ORAI	17	;Next file block.
05000		TAY
05100		INY
05200		BNE	DOL
05300		BEQ	OEOT	;Jump.
05400	
05500	OUTZ:	LDXI	0	;Null file block. (Hole)
05600		BEQ	FBOUT	;Jump.
     

00100	;Compress holes.
00200	CMPRES:	JSR	RHDR	;Read directory header.
00300		BNE	DJ
00400	SQEZ:	JSR	RNDS	;Read directory.
00500		BNE	DJ
00600		LDYI	0
00700	CKHOL:	LDAY	FBUF
00800		CMPI	HMARK	;Look for a hole.
00900		BEQ	HOLE
01000		TYA
01100		CLC
01200		ADCI	20	;Next directory record.
01300		TAY
01400		BNE	CKHOL
01500	
01600		DECZ	SREM	;SREM ← SREM - 2.
01700		DECZ	SREM
01800		BNE	SQEZ
01900	PACKED:	JMP	ACKCLR	;Done.
02000	DJ:	JMP	DIRERR	;Directory read error.
02100	
02200	;Hole found.
02300	HOLE:	LDAY	1013	;FBUF + TRK#
02400		STAZ	HTRK	;Save hole track.
02500		LDAY	1014	;FBUF + SEC#
02600		STAZ	HSEC	;Save hole sector.
02700		STYZ	SVHY	;Save hole dir. index.
02800		LDAZ	CSEC
02900		STAZ	SVHSEC	;Save hole dir. sector.
03000	
03100	FINDF:	CLC	;Update free blocks.
03200		LDAZ	FBLKS
03300		ADCY	1012	;FBUF + FLEN.
03400		STAZ	FBLKS
03500		BCC	FNXTF
03600		INCZ	FBH
03700	
03800	FNXTF:	TYA	;Find next file.
03900		CLC
04000		ADCI	20	;Next dir. record.
04100		TAY
04200		BNE	CKFIL
04300		DECZ	SREM	;SREM ← SREM - 2.
04400		DECZ	SREM
04500		BNE	GSEC
04600		JMP	DONE
04700	GSEC:	JSR	REED	;Read next directory block.
04800		BNE	DJ	;Error.
04900		TAY	;Y ← 0.
05000	CKFIL:	LDAY	FBUF	;Look for file mark.
05100		CMPI	FMARK
05200		BEQ	FFOUND
05300		CMPI	HMARK	;Check if a hole.
05400		BNE	FNXTF
05500		BEQ	FINDF
     

00100	;FBUF ← File directory.
00200	   ;File found. Save file address.
00300	FFOUND:	STYZ	FFDIR	;Save file directory index.
00400		LDAZ	CSEC	;Save file directory sector #.
00500		STAZ	NXHSEC	;?
00600		STAZ	SVSEC
00700		LDXI	0
00800		JSR	FMOV	;Save FBLK.
00900		LDXI	2
01000	FILAD:	LDAZX	NSEC	;Save file addr. and length.
01100		STAZX	FLEN	;FLEN, FITRK, and FISEC.
01200		DEX
01300		BPL	FILAD
01400		JSR	SWDBUF	;Swap disk buffers.
01500	;Fill hole.
01600	FILLIT:	LDAZ	FITRK	;Point to file.
01700		STAZ	CTRK
01800		LDAZ	FISEC
01900		STAZ	CSEC
02000		LDAI	123	;Read two sectors command.
02100		STAZ	CBLK
02200		JSR	RCMDW	;Read a block.
02300		BNE	DJMP
02400	
02500		LDAZ	HTRK	;Point to hole.
02600		STAZ	CTRK
02700		LDXZ	HSEC
02800		STXZ	CSEC
02900		JSR	INCSEC	;Next hole sectors.
03000		STAZ	HTRK
03100		STXZ	HSEC
03200		JSR	WBUFW	;Fill hole.
03300		BNE	DJMP
03400	
03500		DECZ	FLEN	;FLEN ← FLEN - 2.
03600		DECZ	FLEN
03700		BEQ	CUPD	;Check if hole filled.
03800		LDXZ	FISEC
03900		LDAZ	FITRK
04000		JSR	INCSEC	;Next file sectors.
04100		STAZ	FITRK
04200		STXZ	FISEC
04300		BNE	FILLIT	;Jump.
04400	
04500	CUPD:	LDAZ	SVHSEC	;Update directory.
04600		STAZ	CSEC	;Get hole dir. sector.
04700		STAZ	SVOSEC	;Save other sector number.
04800		LDAI	0	;Track zero.
04900		STAZ	CTRK
05000		JSR	REED	;Read hole dir. sector.
05100		BEQ	FIXDIR
05200	DJMP:	JMP	DIRERR	;Directory read error.
     

00100	FIXDIR:	LDXI	0
00200		LDYZ	SVHY	;Get hole dir. index.
00300	UPBLK:	LDAZX	FBLK	;FBUF1 ← FBLK - TRK&SEC
00400		STAY	FBUF1	;Other buffer.
00500		INY
00600		INX
00700		CPXI	13	;FNAME + FMARK & NSEC.
00800		BCC	UPBLK
00900	;Find next file.
01000		LDAZ	NXHSEC	;Get next hole dir. sector #.
01100		STAZ	SVHSEC
01200	
01300		LDYZ	FFDIR	;Get file dir index.
01400		STYZ	SVHY	;New hole Y.
01500		LDAI	HMARK
01600		STAY	FBUF	;Old file ← hole.
01700		JSR	WBUFS	;Write 4 bufs on 2 tracks.
01800		BNE	DJMP
01900		JSR	SETDPO	;Point disk to FBUF.
02000		JMP	FNXTF	;Find next file.
02100	
02200	DONE:	LDAZ	HTRK
02300		STAZ	FFTRK	;Update first free data track.
02400		LDAZ	HSEC
02500		STAZ	FFSEC	;Update first free data sector.
02600		LDYZ	SVHY	;Get first free dir. block.
02700		STAZ	FFDIR
02800		LDXZ	SVHSEC
02900		DEX
03000		STXZ	DSEC	;Update directory sector count.
03100		LDXI	7
03200	BLTIT:	LDAZX	DBLK	;BLT Header into directory.
03300		STAX	FBUF
03400		DEX
03500		BPL	BLTIT
03600	
03700		JSR	WBUFW	;Write header 0.
03800		BNE	UPERR	;Write error.
03900		LDAI	1	;Second track.
04000		STAZ	CTRK
04100		JSR	WBUFW	;Write header 1.
04200		BNE	UPERR	;Write error.
04300		JMP	ACKCLR	;Packed.
04400	UPERR:	JMP	DIRERR	;?
     

00100	FORM:	JSR	GEOT
00200		JSR	MOTON	;Turn on motor.
00300	
00400		JSR	SETDPO	;Point to FBUF.
00500		LDXI	6
00600	CSLOP:	LDAX	FORMT	;Setup command list.
00700		STAZX	CBLK
00800		DEX
00900		BPL	CSLOP
01000	
01100	TKOOP:	LDXI	1	;First sector.
01200		LDYI	0
01300	SCOOP:	LDAZ	FOTRK	;Get track number.
01400		STAY	FBUF	;And setup I.D.s.
01500		INY
01600		LDAI	0
01700		STAY	FBUF	;Head number.
01800		INY
01900		TXA
02000		STAY	FBUF	;Sector number.
02100		INY
02200		LDAI	0
02300		STAY	FBUF	;Length.
02400		INY
02500		INX	;Next sector.
02600		CPXI	=17	;Sectors per track +1.
02700		BCC	SCOOP
02800	
02900		JSR	WUF	;Write buffer.
03000		JSR	BW	;Wait until not busy.
03100	   ;Add verify 16 sectors? Check disk error?
03200		INCZ	FOTRK	;Next track.
03300		LDAZ	FOTRK
03400		CMPI	=35
03500		BCC	TKOOP
03600	
03700		LDAZ	SVERR	;Check for errors?
03800		BNE	FERR
03900		JMP	ACKCLR	;<Ack> and clear flags.
04000	FERR:	JMP	DIRERR
04100	;Wait for input.
04200	GCHR:	LDA	SIOC	;Read SI/O status.
04300		LSRA	;Get rcvr. full bit.
04400		BCC	GCHR
04500		ANDI	30	;FE, OVR.
04600		BNE	CERR
04700		LDA	SIOD	;Input byte.
04800		RTS
04900	CERR:	STAZ	CEFLG	;Save comm. error.
05000		LDAI	0	;Return with null.
05100		RTS
05200	
05300	GEOT:	JSR	GCHR	;Wait for EOT.
05400		CMPI	4	;<EOT>
05500		BNE	TERR
05600		LDAZ	CEFLG	;Check for comm. error.
05700		BNE	TERR
05800		RTS
05900	TERR:	PLA	;Fix stack.
06000		PLA
06100		JMP	ILLCMD
     

00100	PACK:	LDXI	20	;Output <ack>.
00200	;Output byte in X.
00300	OCHR:	LDA	SIOC	;Read SI/O status.
00400		ANDI	2	;Transmiter full bit.
00500		BEQ	OCHR
00600		STX	SIOD	;Output it.
00700		RTS
00800	PSTX:	LDXI	2	;Output <stx>.
00900		BNE	OCHR
01000	
01100	MOTOFF:	LDAI	MOFF	;Turn motor off.
01200		JSR	PCMD
01220		LDAI	0
01300		STAZ	MO	;Motor on flag.
01400		RTS
01500	
01600	   ONES ← 6	;6 = .98s, 7 = 1.15s.
01700	MOTON:	BITZ	MO	;Check if already on.
01800		BMI	SPIN
01900		LDXI	377	;Turn on motor.
02000		STXZ	MO	;Set motor on flag.
02100		INX	;X ← 0.
02200		STXZ	TL	;Setup motor time out.
02300		LDAI	ONES
02400		STAZ	TH
02500		LDAI	MON	;Turn it on.
02600		JSR	PCMD
02700	
02800	MW:	DEX	;Wait for motor on delay.
02900		BNE	MW
03000		DECZ	TL
03100		BNE	MW
03200		DECZ	TH
03300		BNE	MW
03400	
03500	SPIN:	LDAI	0	;Setup motor time out.
03600		STAZ	TL
03700		LDAI	TWOS
03800		STAZ	TH
03900		RTS
     

00100	;Decimal output routine.
00200	ODEC:	CLC
00300		RORA	;/2
00400		STAZ	OCTH
00500		TXA
00600		RORA
00700		STAZ	OCTL
00800		LDAI	=100
00900		JSR	GDIG	;Output hundreds.
01000		LDAI	=10
01100		JSR	GDIG	;Output tens.
01200		LDAZ	OCTL
01300		ORAI	60	;Convert to ascii.
01400		TAX
01500		JMP	OCHR
01600	
01700	GDIG:	STAZ	DIGIT
01800		LDXI	57	;"0" -1.
01900	DIGLOP:	INX
02000		SEC
02100		LDAZ	OCTL
02200		SBCZ	DIGIT
02300		STAZ	OCTL
02400		BCS	DIGLOP
02500		DECZ	OCTH
02600		BPL	DIGLOP
02700		JSR	OCHR	;Output digit.
02800		LDAZ	OCTL
02900		ADCZ	DIGIT
03000		STAZ	OCTL
03100		INCZ	OCTH
03200		RTS
03300	
03400	;Reset and interrupt vectors.
03500	   LOC ZERO + 177772
03600		NMIV∧377	;NMI Vector.
03700		NMIV⊗-10
03800		RST∧377	;Reset vector.
03900		RST⊗-10
04000		IRQV∧377	;IRQ Vector.
04100		IRQV⊗-10
04200	END